home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / modprolg / mod-prol.lha / Prolog / Examples / database.mod < prev    next >
Text File  |  1992-06-15  |  5KB  |  148 lines
  1. % This is an example of a database program. Although it is a rather
  2. % small and very artificial example, it shows of many of the facilities
  3. % available under the modules system. The program itself is very dirty
  4. % however, and is an example of good modular programming.
  5.  
  6. % For example :
  7. %   Asserting into remote structures.
  8. %   Calling predicates in remote structures.
  9. %   The use of term manipulation predicates.
  10. %   I/O Predicates.
  11. %   Moving atoms to remote structures (using dismantle_name/3).
  12.  
  13. signature dataopsig =
  14.     sig
  15.     fun record/2.
  16.         pred add_record/0 and get_record/1.
  17.     end.
  18.  
  19. signature searchsig =
  20.     sig
  21.         pred ismatch/3.
  22.     end.
  23.  
  24. structure database =
  25.     struct
  26.         pred record/2.
  27.     end.
  28.  
  29. structure dataoperations/dataopsig =
  30.     struct
  31.     fun record/2.
  32.         add_record :-
  33.             writename('Type name'),nl,
  34.             get_atom(A),
  35.             writename('Type search keys (terminate with end).'), nl,
  36.             get_keys(List),
  37.             B =.. [data|List],
  38.             structure(Tag,database),
  39.             assert(record(A,B),Tag).
  40.         get_record(record(X,Y)) :-
  41.             var(X), var(Y),
  42.             structure(Tag,database),
  43.             call(record(X,Y),Tag).
  44.                 % Note the use of var/1 to guarantee that no
  45.                 % outer structure references occur during call/2.
  46.         get_atom(X) :-
  47.             repeat,
  48.             writename('> '),
  49.             read(X),
  50.             (atom(X) -> true ;
  51.                 (writename('Data must be an atom, please re-type'),
  52.                  nl,fail)).
  53.         get_keys(List) :-
  54.             get_atom(X),
  55.             (X == end -> List = [] ;
  56.                 (get_keys(Rest),
  57.                  List = [X|Rest])).
  58.     end.
  59.  
  60. structure search1/searchsig =
  61.     struct
  62.         fun item = dataoperations:record.
  63.         ismatch(X,item(A,B),A) :-
  64.             B =.. [_|Rest],    % _ would actually be database:data/0
  65.             member(X,Rest).
  66.     end.
  67.  
  68. structure search2/searchsig =
  69.     struct
  70.         fun item = dataoperations:record.
  71.         ismatch(X,item(A,B),A) :-
  72.             match_args(1,B,X).
  73.         match_args(Arg,B,X) :-
  74.             arg(Arg,B,Item),
  75.         (Item = X -> true ;
  76.                     (Narg is Arg + 1,
  77.                      match_args(Narg,B,X))).
  78.     end.
  79.  
  80. functor time(x/searchsig) =
  81.     struct
  82.         structure search = x.
  83.         inherit dataoperations.
  84.         timesearch(SF) :-
  85.             cputime(X),
  86.             get_results(SF),
  87.             cputime(Y),
  88.             Diff is Y - X,
  89.             writename('Time taken is '),
  90.             writename(Diff), nl.
  91.         get_results(SF) :-
  92.             dataoperations:get_record(X),
  93.             search:ismatch(SF,X,A),
  94.             tab(8),writename('Found '),
  95.             writename(A),
  96.         tab(5),
  97.         write([A]),
  98.             nl,fail.
  99.         get_results(_).
  100.     end.
  101.  
  102. functor menu(x/dataopsig,y/searchsig,z/searchsig) =
  103.     struct
  104.         structure dataops = x.
  105.         structure search1 = time(y).
  106.         structure search2 = time(z).
  107.         menu :-
  108.             nl,
  109.             writename('Select option required'), nl,
  110.             writename(' 1 - Add new record'), nl,
  111.             writename(' 2 - Timed search 1'), nl,
  112.             writename(' 3 - Timed search 2'), nl,
  113.             writename(' 4 - Quit'), nl,
  114.         writename('{Terminate all input with a period (.)}'), nl,
  115.             repeat,
  116.             writename('> '),
  117.             read(X),
  118.             valid_choice(X),
  119.             menu.
  120.         valid_choice(1) :-
  121.             dataops:add_record.
  122.         valid_choice(2) :-
  123.             get_search_key(Key),
  124.             search1:timesearch(Key).
  125.         valid_choice(3) :-
  126.             get_search_key(Key),
  127.             search2:timesearch(Key).
  128.         valid_choice(4) :-
  129.         abort.
  130.     valid_choice(_) :-
  131.         writename('Invalid choice - reselect'), nl, fail.
  132.         get_search_key(Key) :-
  133.             repeat,
  134.             writename('Type search key > '),
  135.             read(X),
  136.             (atom(X) -> (structure(Tag,database),
  137.                          dismantle_name(X,Name,_),
  138.                          dismantle_name(Key,Name,Tag)) ;
  139.                         (writename('Search key must be an atom'),
  140.                          nl,fail)).
  141.                 % Note here that we have to move the atom typed from
  142.                 % the current structure to the structure 'database'
  143.                 % as the original data was moved to 'database' and
  144.                 % the tags must match for the atoms to be equal.
  145.     end.
  146.  
  147. structure program = menu(dataoperations,search1,search2).
  148.